home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS11.ADF / AmigaBasicProgs / Calendar / calendar.main (.txt) < prev    next >
AmigaBASIC Source Code  |  1986-08-05  |  29KB  |  1,179 lines
  1. 'Calendar Main Program  Version 1.0  2-27-86
  2. 'Mark Hurst 503-843-3185
  3.   SCREEN 1,640,200,3,2
  4. DEFINT a-z
  5. WINDOW 1,"***** AMIGA CALENDAR *****",(0,0)-(250,40),0
  6. COLOR 2,1:CLS
  7. PRINT"BY   Mark D. Hurst
  8. PRINT TAB(6)"S.W. McKibben Rd.
  9. PRINT TAB(6)"Sheridan Oregon 97378
  10. PRINT TAB(6)"503-843-3185
  11. DIM yearbuf(27),days.in.month(12),month$(12)
  12. DIM char(50,26),num(50,10),symbol(102,4)
  13. DIM code$(12),Lo(5,6),s(10),f$(10),f(5)
  14. DIM cov.pat(3),r.edge.pat(3),b.edge.pat(3),reset.pat(3)
  15. DIM change.pat(3),yb(42),a$(13),how(8)
  16. FOR x=0 TO 8:READ how(x):NEXT x
  17.   DATA 110,0,150,0,22200,64,10,0,0
  18. SAY TRANSLATE$("Just a Moment While i load some files."),how  
  19. FOR x=0 TO 3:READ r.edge.pat(x):NEXT x
  20.  DATA &h2222,&h2222,&h2222,&h2222
  21. FOR x=0 TO 3:READ cov.pat(x):change.pat(x)=cov.pat(x):NEXT x
  22.  DATA &h7777, &hbbbb, &hdddd, &heeee
  23. FOR x=0 TO 3:READ b.edge.pat(x):NEXT x
  24.  DATA 0,&hffff,0,&hffff
  25. FOR x=0 TO 3:READ reset.pat(x):NEXT x
  26.  DATA -1,-1,-1,-1
  27. FOR x=0 TO 42:READ yb(x):NEXT x
  28.   DATA 31,35,40,46,53,60,77,83,88,92,95,98,101,104
  29.   DATA 107,110,117,104,102,101,94
  30.   DATA 87,80,77,70,63,59,52,46
  31.   DATA 40,34,28,22,16,11,7,4,3,2,1,0,0,0
  32. FOR x=1 TO 15:READ n!,d:SOUND n!,d:NEXT x
  33.   DATA 659.26,4,523 .25,8,587 .33,32,20 ,8,659 .26,4  
  34.   DATA 523.25,8,587 .33,32,20 ,8,587 .33,24,783 .99,8   
  35.   DATA 659.26,24,523 .25,8,587 .33,4,523 .25,8,587 .33,24
  36. FOR x=0 TO 27:READ yearbuf(x):NEXT x
  37.   DATA 6,1,2,3,4,6,7,1,2,4,5,6,7,2,3,4,5,7,1,2,3,5,6,7,1,3,4,5
  38. FOR x=1 TO 12:READ month$(x),days.in.month(x):NEXT x
  39.   DATA JANUARY,31,FEBRUARY,28,MARCH,31,APRIL,30
  40.   DATA MAY,31,JUNE,30,JULY,31,AUGUST,31
  41.   DATA SEPTEMBER,30,OCTOBER,31,NOVEMBER,30,DECEMBER,31
  42. FOR x=1 TO 7:READ day.name$(x):NEXT x
  43.   DATA "Sunday   ","Monday   ","Tuesday  "
  44.   DATA Wednesday,"Thursday ","Friday   ","Saturday "
  45. OPEN "16x16.num.set" FOR INPUT AS 1
  46.   FOR x=1 TO 10:FOR y=0 TO 50
  47.     num(y,x)=CVI(INPUT$(2,1))
  48.   NEXT y,x:CLOSE 1   
  49. OPEN "16x16.char.set" FOR INPUT AS 1
  50.   FOR x=1 TO 26:FOR y=0 TO 50
  51.    char(y,x)=CVI(INPUT$(2,1))
  52.   NEXT y,x:CLOSE 1
  53. OPEN "cal.symbol" FOR INPUT AS 1
  54.   FOR x=1 TO 4:FOR y=0 TO 102
  55.     symbol(y,x)=CVI(INPUT$(2,1))
  56.   NEXT y,x:CLOSE 1
  57. FOR x=1 TO 22:READ n!,d:SOUND n!,d:NEXT x
  58.   DATA 783.99,3,20 ,1,783 .99,3,20 ,1,783 .99,3
  59.   DATA 20,1,783 .99,3,880 ,4,20 ,4,743 ,8,659 .26,20
  60.   DATA 20,4,783 .99,3,20 ,1,783 .99,3,20 ,1,783 .99,3
  61.   DATA 20,1,783 .99,3,880 ,4,20 ,4,743 ,8
  62. open.files:
  63.   OPEN "cal.data" AS 1 LEN=310
  64.    FIELD 1,300 AS c.dat$, 10 AS s.nam$
  65.     IF LOF(1)/310 <366 THEN GOSUB new.file    
  66.   OPEN "cal.symbol.dat" AS 4 LEN=32
  67.    FIELD 4,32 AS cod$
  68.     FOR x=1 TO 12:GET 4:code$(x)=cod$:NEXT x
  69. Skip4:     
  70.   WINDOW 2,"Amiga Calendar",(0,0)-(564,186),16,1
  71.   WINDOW CLOSE 1
  72. PALETTE 4,1,0,0     'red
  73. PALETTE 5,0,0.7,0    'dk.green
  74. PALETTE 6,0.8,0.6,0.53 'brown
  75. PALETTE 7,1,0.7,0    'orange
  76. draw.calendar: DIM b2(393)
  77.   COLOR 6,1
  78.   LINE (410,5)-(542,17),6,bf
  79.   COLOR 0,6
  80.   LOCATE 2,53:PRINT"PAYMENT SCEDULE""
  81.   GET (410,5)-(542,17),b2
  82.   COLOR 6,1:CLS
  83.   COLOR 5,1
  84.   LOCATE 3,2
  85. FOR x=1 TO 19:READ n!,d:SOUND n!,d:NEXT x
  86.   DATA 659.26,20,20 ,4,783 .99,3,20 ,1,783 .99,3,20 ,1
  87.   DATA 783.99,3,20 ,1,783.99,3,880 ,4,20 ,4,743 ,8
  88.   DATA 659.26,8,587 .33,8,659 .26,8,743 ,4,659 .26,6
  89.   DATA 20,2,743,32
  90.   FOR x=1 TO 7
  91.     PRINT day.name$(x)" ";     
  92.   NEXT x
  93. get.current.date
  94.  draw.lines
  95.   put.date
  96.    find.buffers
  97.     fill.in.numbers 
  98. draw.menu:  
  99.   LINE(20,174)-(0,180),4:LINE-(20,184),4
  100.   LINE(148,174)-(168,180),4:LINE-(148,184),4
  101.   LINE(20,174)-(148,184),4,b
  102.   LINE (60,174)-(60,184),4
  103.   LINE(108,174)-(108,184),4
  104.   PAINT (21,175),4:PAINT(147,175),4
  105.   LOCATE 23,4:COLOR 1,4:PRINT"LAST";TAB(15);"NEXT";
  106.   COLOR 4,1:LOCATE 23,9:PRINT"MONTH";
  107.   LINE(188,174)-(252,184),4,bf
  108.   LINE(260,174)-(300,184),4,bf
  109.   LINE(338,174)-(396,184),0,bf
  110.   LINE(402,174)-(458,184),0,bf
  111.   LINE(466,174)-(518,184),0,bf
  112.   LINE(522,174)-(562,184),0,bf
  113.   LOCATE 23,25:COLOR 1,4:PRINT"RESTORE";TAB(34);"JUMP";
  114.   COLOR 1,0
  115.   LOCATE 23,44:PRINT"UPDATE";TAB(52);"REMIND";TAB(60);"DIARY";TAB(67);"QUIT";
  116.   tx=184:COLOR 2,1
  117. FOR x=1 TO 4: 
  118.   LINE(tx,145)-(tx+18,160),0,bf
  119.   PUT(tx,145),symbol(0,x) 
  120.   tx=tx+80
  121. NEXT x
  122.   LOCATE 21,22:PRINT"BIRTHDAY";TAB(33);"BILLS";TAB(42);"MEETINGS";
  123.   PRINT TAB(53);"NOTES";TAB(62);"HOLIDAYS";
  124.   COLOR 4,1:LOCATE 19,64:PRINT"RED"
  125.   LOCATE 20,62:PRINT"NUMBERS"
  126.   LINE (1,167)-(559,167),4
  127.    PUT(432,0),b2
  128.   ERASE b2
  129.    put.day.symbols
  130.     mark.day
  131.   sw.type=0:how(7)=1
  132. main.menu: 
  133.   SAY TRANSLATE$("ready."),how
  134.  wait.for.mouse:
  135.     IF MOUSE(0)>-1 THEN SLEEP:GOTO wait.for.mouse
  136. stay.1:
  137.   IF MOUSE(0)<0 THEN stay.1
  138.   IF MOUSE(1)>558 THEN BEEP:GOTO main.menu
  139.   'IF MOUSE(1)<150 AND MOUSE(2)<13 THEN GOSUB set.today.date:GOTO main.menu
  140.   IF MOUSE(1)>436 AND MOUSE(2)<13 THEN GOSUB payment.scedule:GOTO main.menu
  141.   IF MOUSE(2)<24 THEN BEEP:GOTO main.menu
  142.   'switch days and post.day
  143.   IF MOUSE(2)>23 AND MOUSE(2)<168 THEN
  144.     d=(INT((MOUSE(2)-24)/24)*7)+(INT((MOUSE(1)+1)/80))-month.marg+2
  145.     IF d<1 OR d>days.in.month(mo) THEN
  146.       BEEP:GOTO wait.for.mouse
  147.     ELSE  
  148.       IF d=day THEN GOSUB post.day:GOTO main.menu
  149.       mark.day
  150.         day=d
  151.       mark.day
  152.       GOTO wait.for.mouse 
  153.     END IF  
  154.   END IF
  155.   'bottom menu items
  156.   IF MOUSE(2)>185 OR MOUSE(2)<175 THEN BEEP GOTO wait.for.mouse
  157.   IF MOUSE(1)<56 THEN GOSUB last.:GOTO main.menu
  158.   IF MOUSE(1)<108 THEN GOSUB switch:GOTO main.menu
  159.   IF MOUSE(1)<168 THEN GOSUB next.:GOTO main.menu
  160.   IF MOUSE(1)<272 THEN GOSUB restore.:GOTO main.menu
  161.   IF MOUSE(1)<300 THEN GOSUB jump:GOTO main.menu
  162.   IF MOUSE(1)<396 THEN GOSUB update:GOTO main.menu
  163.   IF MOUSE(1)<456 THEN GOSUB remind
  164.   IF MOUSE(1)<516 THEN GOSUB diary
  165.   CLOSE:SCREEN CLOSE 1:WINDOW 1:CLS:PRINT"Have a Nice Day"
  166.   SAY TRANSLATE$("have a nice day."):SYSTEM
  167. END
  168. switch:
  169.   IF sw.type THEN 
  170.    sw.type=0:LOCATE 23,9
  171.    COLOR 4,1:PRINT"MONTH"; 
  172.   ELSE 
  173.    sw.type=1:LOCATE 23,9
  174.    COLOR 4,1:PRINT"YEAR ";
  175.   END IF
  176.  stay.here: 
  177.     IF MOUSE(0)<0 THEN stay.here
  178.   RETURN wait.for.mouse
  179. next.:
  180.   IF sw.type=0 THEN
  181.     IF mo=12 THEN:mo=1:year=year+1:year$=MID$(STR$(year),2) :ELSE mo=mo+1  
  182.   ELSE
  183.     year=year+1
  184.     year$=MID$(STR$(year),2)
  185.   END IF
  186.   GOTO new.screen
  187.  
  188. restore.:
  189.   IF year$=RIGHT$(DATE$,4) AND mo=VAL(LEFT$(DATE$,2)) THEN
  190.     IF day=VAL(MID$(DATE$,4,2)) THEN RETURN
  191.       mark.day
  192.       day=VAL(MID$(DATE$,4,2))
  193.       mark.day
  194.       RETURN
  195.   END IF
  196.     get.current.date
  197.     GOTO new.screen
  198.  
  199. jump: SAY TRANSLATE$("Jump to any calendar."),how                 
  200.   WINDOW 3,"Type in Date (MO/DY/YEAR)",(40,150)-(280,160),0,1
  201.  again: 
  202.    LOCATE 1,15:LINE INPUT; d$
  203.      m=VAL(LEFT$(d$,2)):d=VAL(MID$(d$,4,2))
  204.      y$=MID$(d$,7):y=VAL(y$)
  205.    IF m<1 OR m>12 OR y<1 OR d<1 OR d>days.in.month(mo) THEN again:
  206.    IF y=year AND m=mo THEN
  207.      IF d=day THEN WINDOW CLOSE 3:RETURN main.menu         
  208.      mark.day
  209.      day=d
  210.      mark.day
  211.      WINDOW CLOSE 3:RETURN main.menu
  212.    END IF  
  213.    WINDOW CLOSE 3
  214.    day=d:mo=m:year=y:year$=y$
  215.    GOTO new.screen
  216. last.:
  217.   IF sw.type=0 THEN
  218.     IF mo=1 THEN:mo=12:year=year-1:year$=MID$(STR$(year),2) :ELSE mo=mo-1    
  219.   ELSE
  220.     year=year-1
  221.     year$=MID$(STR$(year),2) 
  222.   END IF
  223. new.screen:
  224.   clear.screen
  225.    draw.lines
  226.     put.date
  227.      find.buffers
  228.       fill.in.numbers
  229.        put.day.symbols
  230.         mark.day
  231.   RETURN
  232. SUB get.current.date STATIC
  233.  SHARED mo,day,year$,year
  234.   mo=VAL(LEFT$(DATE$,2)):day=VAL(MID$(DATE$,4,2))
  235.   year$=RIGHT$(DATE$,4):year=VAL(year$)
  236.   END SUB
  237. SUB mark.day STATIC
  238. SHARED month.marg,day
  239.   WINDOW OUTPUT 2
  240.   v=INT((day+month.marg-2)/7)
  241.   h=((day-2+month.marg) MOD 7)
  242.   LOCATE v*3+4,h*10+2
  243.   c1=POINT(h*80+16,v*24+24)
  244.   c2=POINT(h*80+12,v*24+24)
  245.   COLOR c1,c2:PRINT MID$(STR$(day)+" ",2,2) 
  246.   END SUB
  247. SUB put.day.symbols STATIC
  248.  SHARED mo,days.in.month(),code$(),month.marg,symbol()
  249.   FOR x=1 TO days.in.month(mo)
  250.     IF MID$(code$(mo),x,1)<>CHR$(0) THEN
  251.       s=1:z=1:code=ASC(MID$(code$(mo),x,1))
  252.       FOR y=1 TO 5
  253.         IF code AND z THEN
  254.           IF y=5 THEN
  255.             v=INT((x+month.marg-2)/7)
  256.             h=((x-2+month.marg) MOD 7)
  257.             LOCATE v*3+4,h*10+2
  258.             COLOR 4,1:PRINT MID$(STR$(x)+" ",2,2) 
  259.           ELSE
  260.             v=INT((x+month.marg-2)/7)*24+31
  261.             h=((x-2+month.marg) MOD 7)*80+s
  262.             LINE(h,v)-(h+18,v+15),0,bf
  263.             PUT(h,v),symbol(0,y)
  264.             s=s+20
  265.           END IF
  266.         END IF
  267.         z=z*2
  268.       NEXT y      
  269.     END IF
  270.   NEXT x
  271.   END SUB
  272. SUB clear.screen STATIC
  273.   LINE(0,23)-(160,167),1,bf
  274.   LINE(166,0)-(412,15),1,bf
  275.   LINE(161,23)-(560,143),1,bf
  276.   END SUB
  277. SUB draw.lines STATIC
  278.   FOR x=0 TO 560 STEP 80
  279.     LINE (x,14)-(x,167),4
  280.   NEXT x
  281.   FOR x=23 TO 167 STEP 24
  282.     LINE (0,x)-(559,x),4
  283.   NEXT x
  284.   END SUB  
  285. SUB fill.in.numbers STATIC  
  286.  SHARED mo,month.marg,days.in.month()
  287.   d=month.marg:y=4
  288.   IF month.marg=1 THEN COLOR 4,1 :ELSE COLOR 2,1
  289.   FOR x=1 TO days.in.month(mo)
  290.     IF d=2 THEN COLOR 2,1
  291.     LOCATE y,(d-1)*10+2:PRINT MID$(STR$(x),2)
  292.     d=d+1:IF d=8 THEN y=y+3:COLOR 4,1:d=1
  293.   NEXT x
  294.   END SUB
  295.  
  296. SUB find.buffers STATIC
  297.  SHARED total.d,mo,year,days.in.month()
  298.  SHARED yearbuf(),leap.buf,month.marg
  299.  total.d=0
  300.   IF mo=1 THEN skip1
  301.   IF year/4=INT(year/4) THEN
  302.     days.in.month(2)=29:leap.buf=0
  303.   ELSE
  304.     days.in.month(2)=28:leap.buf=1
  305.   END IF
  306.   FOR x=1 TO mo-1
  307.     total.d=total.d + days.in.month(x)
  308.   NEXT x
  309.  skip1:
  310.   month.marg=total.d-(INT(total.d/7)*7)+yearbuf(year MOD 28)
  311.   IF month.marg>7 THEN month.marg=month.marg-7    
  312.   END SUB
  313. SUB put.date STATIC  
  314.  SHARED month$(),year$
  315.  SHARED mo,char(),num() 
  316.   LINE(166,0)-(LEN(month$(mo))*16+165,15),0,bf
  317.  FOR x=1 TO LEN(month$(mo))
  318.   c=ASC(MID$(month$(mo),x,1))-64
  319.   PUT (x*16+150,0),char(0,c)
  320.  NEXT x
  321.   LINE(326,0)-(LEN(year$)*16+325,15),0,bf
  322.  FOR x=1 TO LEN(year$)
  323.   n=ASC(MID$(year$,x,1))-47
  324.   IF n<1 OR n>10 THEN skip5
  325.   PUT (310+(x*16),0),num(0,n)
  326.  skip5:
  327.  NEXT x      
  328.  END SUB      
  329.    
  330. post.day: SAY TRANSLATE$("post data."),how
  331.   no.input=1
  332.   d$= month$(mo)+STR$(day)+","+year$+"   Calendar Input Screen"
  333.   WINDOW 3,d$,(0,0)-(564,186),0,1
  334.   COLOR 2,3:CLS
  335.     LINE(284,0)-(284,186),2:LINE(0,71)-(564,71),2
  336.     LINE(0,143)-(564,143),2
  337.   put.bold.char "BIRTHDAYS",66,0
  338.   put.bold.char "BILLS",384,0
  339.   put.bold.char "MEETINGS",78,72
  340.   put.bold.char "NOTES",384,72
  341.   put.bold.char "HOLIDAY",86,144
  342.   put.bold.char "EXIT",392,144
  343.    LOCATE 3,4:PRINT "Name";TAB(28);"Year";TAB(38);"Pay To";TAB(58);"Amount"
  344.    LOCATE 12,3:PRINT"What?";TAB(15);"Where?";TAB(27);"When?"
  345.    LOCATE 21,6:PRINT"Name";TAB(22);"Permanent?"; 
  346.   'get data & put
  347.   rec=total.d+day
  348.   IF rec> 59 THEN rec=rec+leap.buf
  349.   GOSUB get.data 
  350.   COLOR 0,3
  351.  put.on.screen:  ERASE Lo:DIM Lo(6,5)
  352.     FOR x=1 TO 10
  353.       IF s(x)>0 THEN
  354.         ON s(x) GOSUB p.birth,p.bill,p.meet,p.note,p.holi
  355.       ELSE
  356.         f$(x)=SPACE$(30)
  357.       END IF
  358.     NEXT x
  359.  day.menu:
  360.   LOCATE 23,45:COLOR 2,4:PRINT"MAKE A SELECTION";  
  361.   repeat:
  362.    IF MOUSE(0)>-1 THEN SLEEP:GOTO repeat
  363.      LOCATE 23,45:COLOR 0,3:PRINT SPACE$(16);  
  364.    IF MOUSE(1)<284 AND MOUSE(2)<72 THEN GOSUB i.birth
  365.    IF MOUSE(1)>283 AND MOUSE(2)<72 THEN GOSUB i.bill
  366.    IF MOUSE(1)<284 AND MOUSE(2)>143 THEN GOSUB i.holiday
  367.    IF MOUSE(1)>283 AND MOUSE(2)>143 THEN exit.input
  368.    IF MOUSE(1)<284 THEN GOSUB i.meet
  369.    IF MOUSE(1)>283 THEN GOSUB i.note
  370.   end.of.menu: 
  371.    IF flag=1 THEN 
  372.    ON t GOSUB clear1,clear2,clear3,clear4,clear5
  373.     FOR x=1 TO 10
  374.       IF s(x)=t THEN
  375.         ON s(x) GOSUB p.birth,p.bill,p.meet,p.note,p.holi
  376.       END IF
  377.     NEXT x
  378.    END IF
  379.      flag=0
  380.    GOTO day.menu    
  381.  
  382. SUB put.bold.char (word$,topx,topy) STATIC
  383.  SHARED char()
  384.  'LINE(topx,topy)-(LEN(word$)*16+topx-1,topy+15),0,bf
  385.   FOR x=0 TO LEN(word$)-1
  386.     c=ASC(MID$(word$,x+1,1))-64
  387.     PUT (x*16+topx,topy),char(0,c)
  388.   NEXT x
  389.   END SUB
  390.  
  391.  i.holiday:              
  392.    IF Lo(5,0)=0 THEN 
  393.      find.next.open next.o  
  394.      IF flag=2 THEN RETURN end.of.menu
  395.      n=next.o:flag=3:input.data 5,22,1,1,27,1,n
  396.    ELSE 
  397.      n=Lo(5,1)
  398.      input.data 5,22,1,1,27,1,n
  399.    END IF
  400.    IF flag=1 THEN RETURN end.of.menu
  401.   input.again: 
  402.    LOCATE 22,28:PRINT"y/n";:a$=INPUT$(1)
  403.    IF UCASE$(a$)="Y" THEN 
  404.      MID$(f$(n),28)="YES"
  405.    ELSEIF UCASE$(a$)="N" THEN 
  406.      MID$(f$(n),28)="NO "
  407.    ELSE
  408.      GOTO input.again:
  409.    END IF
  410.    LOCATE 22,28:PRINT RIGHT$(f$(n),3)+"   "
  411.    RETURN end.of.menu
  412.  i.birth:
  413.      IF MOUSE(2)>23 AND MOUSE(2)<Lo(1,0)*8+23 THEN 'edit
  414.        p=INT(MOUSE(2)/8)-2
  415.        IF MOUSE(1)<204 THEN input.data 1,3+p,1,1,26,p,Lo(1,p) :ELSE input.data 1,3+p,28,27,4,p,Lo(1,p)
  416.      ELSE 
  417.        find.next.open next.o
  418.        IF flag<>2 THEN
  419.          input.data 1,Lo(1,0)+4,1,1,26,Lo(1,0)+1,next.o
  420.        IF flag=1 THEN RETURN end.of.menu
  421.          flag=3
  422.          input.data 1,Lo(1,0)+4,28,27,4,Lo(1,0)+1,next.o
  423.        END IF
  424.      END IF
  425.    RETURN end.of.menu     
  426.  i.bill:
  427.      IF MOUSE(2)>23 AND MOUSE(2)<Lo(2,0)*8+23 THEN 'edit
  428.        p=INT(MOUSE(2)/8)-2
  429.        IF MOUSE(1)<448 THEN input.data 2,3+p,37,1,20,p,Lo(2,p) :ELSE input.data 2,3+p,58,21,10,p,Lo(2,p)
  430.      ELSE 
  431.        find.next.open next.o
  432.        IF flag<>2 THEN
  433.          input.data 2,Lo(2,0)+4,37,1,20,Lo(2,0)+1,next.o
  434.          IF flag=1 THEN RETURN end.of.menu
  435.          flag=3
  436.         input.data 2,Lo(2,0)+4,58,21,10,Lo(2,0)+1,next.o
  437.        END IF
  438.      END IF
  439.    RETURN end.of.menu     
  440.  i.meet:
  441.      IF MOUSE(2)>95 AND MOUSE(2)<Lo(3,0)*8+95 THEN
  442.        p=INT(MOUSE(2)/8)-11
  443.        IF MOUSE(1)<99 THEN 
  444.          input.data 3,12+p,1,1,12,p,Lo(3,p)
  445.        ELSEIF MOUSE(1)<195 THEN
  446.          input.data 3,12+p,14,13,12,p,Lo(3,p)
  447.        ELSE
  448.          input.data 3,12+p,27,25,6,p,Lo(3,p)
  449.        END IF
  450.      ELSE 
  451.        find.next.open next.o
  452.        IF flag<>2 THEN 
  453.          input.data 3,Lo(3,0)+13,1,1,12,Lo(3,0)+1,next.o
  454.          IF flag=1 THEN RETURN end.of.menu
  455.          input.data 3,Lo(3,0)+13,14,13,12,Lo(3,0)+1,next.o
  456.          IF flag=1 THEN RETURN end.of.menu
  457.          flag=3
  458.          input.data 3,Lo(3,0)+13,27,25,6,Lo(3,0)+1,next.o
  459.        END IF
  460.      END IF
  461.    RETURN end.of.menu     
  462.  i.note:
  463.      IF MOUSE(2)>95 AND MOUSE(2)<Lo(4,0)*8+95 THEN 'edit
  464.        p=INT(MOUSE(2)/8)-11
  465.        input.data 4,12+p,37,1,30,p,Lo(4,p)
  466.      ELSE 
  467.        find.next.open next.o
  468.        IF flag<>2 THEN flag=3:input.data 4,Lo(4,0)+13,37,1,30,Lo(4,0)+1,next.o
  469.      END IF
  470.    RETURN end.of.menu     
  471. SUB input.data (type,px,py,fpos,length,tpos,no) STATIC
  472. SHARED s(),Lo(),f$(),flag,no.input,t
  473.   IF tpos>5 THEN BEEP:EXIT SUB
  474.   no.input=0:c=4:p=1:GOSUB putcursor
  475.   word$=MID$(f$(no),fpos,length)
  476.  getkey: a$=INKEY$
  477.    WHILE a$="":a$=INKEY$
  478.    IF MOUSE(0)<0 THEN exit.sub
  479.    WEND
  480.   IF a$<CHR$(127) AND a$>CHR$(31) THEN
  481.    IF p>length THEN BEEP:GOTO getkey
  482.     MID$(word$,p,1)=a$:LOCATE px,py:PRINT word$
  483.      p=p+1:c=4:GOSUB putcursor
  484.       GOTO getkey
  485.   END IF        
  486.   IF a$=CHR$(127) THEN
  487.     flag=1:s(no)=0:Lo(type,0)=0:t=type
  488.     f$(no)=STRING$(30,32)
  489.     EXIT SUB
  490.   END IF
  491.    IF a$=CHR$(13) THEN 
  492.    exit.sub:
  493.      MID$(f$(no),fpos,length)=word$
  494.      IF flag=3 THEN s(no)=type:Lo(type,tpos)=no:Lo(type,0)=Lo(type,0)+1
  495.      c=3:GOSUB putcursor
  496.      EXIT SUB
  497.    END IF          
  498.   IF a$=CHR$(8) THEN
  499.     IF p>1 THEN
  500.       IF p=>length THEN c=3:GOSUB putcursor
  501.       p=p-1
  502.       word$=LEFT$(word$,p-1)+MID$(word$,p+1)+" "
  503.       LOCATE px,py:PRINT word$
  504.       c=4:GOSUB putcursor:GOTO getkey
  505.     ELSE
  506.       BEEP:GOTO getkey
  507.     END IF
  508.   END IF
  509.    IF a$=CHR$(30) THEN
  510.      IF p>length THEN BEEP:GOTO getkey
  511.      c=3:GOSUB putcursor:p=p+1:c=4:GOSUB putcursor
  512.      GOTO getkey
  513.    END IF
  514.   IF a$=CHR$(31) THEN
  515.     IF p=1 THEN BEEP:GOTO getkey
  516.     c=3:GOSUB putcursor:p=p-1:c=4:GOSUB putcursor
  517.     GOTO getkey
  518.   END IF
  519.  BEEP:GOTO getkey
  520.   putcursor:
  521.     LINE((py+p-2)*8,(px-1)*8)-((py+p-2)*8,(px-1)*8+6),c
  522.     RETURN
  523.   END SUB
  524.  
  525. SUB find.next.open (n) STATIC
  526. SHARED flag,s()
  527.   FOR n=1 TO 10:IF s(n)=0 THEN EXIT SUB
  528.   NEXT n
  529.   BEEP:flag=2
  530.   END SUB
  531.   
  532. clear1: LINE (0,24)-(283,70),3,bf:RETURN
  533. clear2: LINE (285,24)-(564,70),3,bf:RETURN
  534. clear3: LINE (0,96)-(283,142),3,bf:RETURN
  535. clear4: LINE (285,96)-(564,142),3,bf:RETURN
  536. clear5: LINE (0,168)-(283,178),3,bf:RETURN
  537.   p.birth:
  538.     Lo(1,0)=Lo(1,0)+1:LOCATE Lo(1,0)+3,1
  539.     PRINT LEFT$(f$(x),25)" "RIGHT$(f$(x),5)
  540.     Lo(1,Lo(1,0))=x:RETURN
  541.   p.bill:    
  542.     Lo(2,0)=Lo(2,0)+1:LOCATE Lo(2,0)+3,37
  543.     PRINT LEFT$(f$(x),20)" "RIGHT$(f$(x),10)
  544.     Lo(2,Lo(2,0))=x:RETURN
  545.   p.meet:
  546.     Lo(3,0)=Lo(3,0)+1:LOCATE Lo(3,0)+12,1
  547.     PRINT LEFT$(f$(x),12)" "MID$(f$(x),13,12)" "RIGHT$(f$(x),6)
  548.     Lo(3,Lo(3,0))=x:RETURN
  549.   p.note:
  550.     Lo(4,0)=Lo(4,0)+1:LOCATE Lo(4,0)+12,37
  551.     PRINT f$(x)
  552.     Lo(4,Lo(4,0))=x:RETURN
  553.   p.holi: LOCATE 22,1
  554.     PRINT f$(x):Lo(5,0)=1:Lo(5,1)=x
  555.     RETURN
  556.  
  557.  exit.input:
  558.   WINDOW CLOSE 3
  559.   IF no.input THEN skip6 
  560.    code=0:z=1:s=1
  561.      v=INT((day+month.marg-2)/7)*24+31
  562.      h=((day-2+month.marg) MOD 7)*80+1
  563.      LINE(h,v)-(h+78,v+15),1,bf
  564.    FOR y=1 TO 5
  565.      IF Lo(y,0) THEN 
  566.        code=code+z
  567.        IF y=5 THEN
  568.          calc.pos v,h
  569.          LOCATE v*3+4,h*10+2
  570.          COLOR 1,4:PRINT MID$(STR$(day)+" ",2,2) 
  571.        ELSE
  572.          calc.pos v,h
  573.          v=v*24+31
  574.          h=h*80+s
  575.          LINE(h,v)-(h+18,v+15),0,bf
  576.          PUT(h,v),symbol(0,y)
  577.          s=s+20
  578.        END IF
  579.      ELSEIF y=5 AND h>1 THEN
  580.        calc.pos v,h
  581.        LOCATE v*3+4,h*10+2
  582.        COLOR 1,2:PRINT MID$(STR$(day)+" ",2,2) 
  583.      ELSEIF y=5 AND h<2 THEN
  584.        calc.pos v,h
  585.        LOCATE v*3+4,2
  586.        COLOR 1,4:PRINT MID$(STR$(day)+" ",2,2) 
  587.      END IF
  588.      z=z*2
  589.    NEXT y 
  590.    MID$(code$(mo),day,1)=CHR$(code)
  591.    LSET cod$=code$(mo):PUT #4,mo
  592.    GOSUB set.data:PUT 1,rec
  593.   skip6: 
  594.    RETURN main.menu
  595. SUB calc.pos (v,h) STATIC
  596. SHARED day,month.marg
  597.   v=INT((day+month.marg-2)/7)
  598.   h=((day-2+month.marg) MOD 7)
  599.   END SUB
  600.      
  601. update: SAY TRANSLATE$("update data for last thirty days."),how
  602.    GOSUB restore.
  603.   d$= month$(mo)+STR$(day)+","+year$+"   UPDATE LAST 30 DAYS"  
  604.   WINDOW 3,d$,(16,70)-(544,126),0,1
  605.   COLOR 7,2:CLS
  606.   d=day:m=mo:y=year:rec=total.d+d
  607.   marg=month.marg+day-1:p=0:flag=0
  608.   IF rec>59 THEN rec=rec+leap.buf
  609.   FOR x=30 TO 0 STEP -1 
  610.     IF rec=60 THEN rec=rec-leap.buf
  611.     IF d=0 THEN
  612.       m=m-1
  613.       IF m=0 THEN m=12:y=y-1:rec=366
  614.       d=days.in.month(m)
  615.     END IF  
  616.     IF ASC(MID$(code$(m),d,1))>1 THEN 
  617.       GOSUB get.data
  618.       dat$=month$(m)+STR$(d)+","+STR$(year)
  619.       FOR z=1 TO 10
  620.         IF s(z)>1 THEN
  621.           nam$=f$(z)
  622.           flag=1:CLS
  623.           ON s(z)-1 GOSUB u.bill,u.meet,u.note,u.holiday
  624.         END IF
  625.       NEXT z
  626.     END IF
  627.     IF w.flag THEN 
  628.       w.flag=0:code=0
  629.       ERASE f:DIM f(5)
  630.       FOR z=1 TO 10:IF s(z) THEN f(s(z))=1
  631.       NEXT z
  632.       GOSUB set.data
  633.       v=1:FOR f=1 TO 5:code=code+(v*f(f)):v=v*2:NEXT f
  634.       MID$(code$(m),d,1)=CHR$(code)
  635.       LSET cod$=code$(m):PUT #4,m
  636.     END IF
  637.     d=d-1:rec=rec-1
  638.   NEXT x :IF flag=0 THEN PRINT"Everything Was Up To Date" :ELSE flag=0
  639.    PRINT"Checking Payment Scedules . . ."
  640.    OPEN "pay.scedule" AS 5 LEN=39
  641.    FIELD 5, 20 AS pay.to$,10 AS amt$,2 AS day$,7 AS lp$
  642.    np$=SPACE$(18)
  643.    FOR x=1 TO 18:GET 5
  644.      IF VAL(day$)=0 THEN MID$(np$,x,1)="0" :ELSE MID$(np$,x,1)="1"
  645.    NEXT x
  646.   GOSUB ps.exit
  647.  GOTO new.screen 
  648. u.bill: GOSUB head.1:GOSUB print.1
  649.   PRINT"Did You Pay This Bill ? (y/n)";
  650.   get.answer:
  651.   a$=UCASE$(INPUT$(1))
  652.   IF a$="Y" THEN w.flag=1:s(z)=0:f$(z)="":RETURN
  653.   IF a$="N" THEN RETURN
  654.   LOCATE 4,1:PRINT"COME ON NOW, GIVE ME A STRAIGHT ANSWER !!
  655.   GOTO get.answer
  656. u.meet: PRINT"Deleting Meeting . . . "
  657.   GOSUB print.2:w.flag=1:s(z)=0:f$(z)=""
  658.   FOR pause=0 TO 5000:NEXT pause
  659.   RETURN
  660. u.note: PRINT dat$
  661.   PRINT "Did You ... ";f$(z);"? (y/n)"
  662.   a$=UCASE$(INPUT$(1))
  663.   IF a$="Y" THEN w.flag=1:s(z)=0:f$(z)="":RETURN
  664.   IF a$="N" THEN RETURN
  665.   LOCATE 4,1:PRINT"I HOPE YOU DID IT BETTER THAN YOU ARE PRESSING KEYS ... TRY AGAIN"
  666.   GOTO get.answer
  667. u.holiday:
  668.   IF RIGHT$(f$(z),3)="YES" THEN RETURN
  669.   PRINT"Deleting Holiday . . .":PRINT dat$
  670.   PRINT LEFT$(f$(z),27):s(z)=0:f$(z)="":w.flag=1    
  671.   FOR pause=0 TO 7000:NEXT pause
  672.   RETURN
  673.  
  674. remind: SAY TRANSLATE$("Reminders for the next thirty days."),how
  675.    GOSUB restore.
  676.   d$= month$(mo)+STR$(day)+","+year$+"   REMINDERS FOR THE NEXT 30 DAYS"
  677.   WINDOW 3,d$,(0,0)-(504,186),0,1
  678.   COLOR 0,7:CLS:SAY TRANSLATE$("birthdays."),how
  679.   put.bold.char "BIRTHDAYS",172,0
  680.   PUT (136,0),symbol(0,1)
  681.   PUT (336,0),symbol(0,1)
  682.    LOCATE 3,4:PRINT "Name":LOCATE 3,28:PRINT"Day Name"
  683.    LOCATE 3,39:PRINT"Date":LOCATE 3,57:PRINT"Born"
  684.   d=day:m=mo:y=year:rec=total.d+d
  685.   marg=month.marg+day-1:p=0:flag=0
  686.   IF rec>59 THEN rec=rec+leap.buf
  687. OPEN "ram:temp" AS 5 LEN=58
  688. FIELD 5, 30 AS nam$,1 AS type$,27 AS dat$
  689.   FOR x=0 TO 30  
  690.     IF rec=60 THEN rec=rec+leap.buf
  691.     IF d>days.in.month(m) THEN d=1:m=m+1
  692.     IF m>12 THEN m=1:y=y+1:rec=1
  693.     IF ASC(MID$(code$(m),d,1))>0 THEN 
  694.       GOSUB get.data 
  695.        FOR z=1 TO 10
  696.         IF s(z)>0 THEN
  697.           IF s(z)=1 THEN
  698.             flag=1
  699.             PRINT LEFT$(f$(z),26)" ";
  700.             PRINT day.name$(((marg+x-1) MOD 7)+1)" ";
  701.             PRINT USING"\                 \";month$(m)+STR$(d)+","+STR$(year);
  702.             PRINT RIGHT$(f$(z),4)
  703.             p=p+1:IF p>18 THEN wait.for.key:p=0:CLS
  704.           ELSE
  705.             LSET nam$=f$(z):LSET type$=CHR$(s(z)) 
  706.             IF x=0 THEN
  707.               LSET dat$="TODAY"
  708.             ELSEIF x=1 THEN
  709.               LSET dat$="TOMORROW"
  710.             ELSE              
  711.               LSET dat$=day.name$(((marg+x-1) MOD 7)+1)+" "+month$(m)+STR$(d)+","+STR$(year)
  712.             END IF
  713.             PUT 5
  714.           END IF
  715.         END IF
  716.       NEXT z
  717.     END IF
  718.     d=d+1:rec=rec+1
  719.   NEXT x :IF flag=0 THEN PRINT"None Recorded" :ELSE flag=0
  720.   wait.for.key
  721. FOR x=2 TO 5
  722.  CLS:p=0:total#=0 
  723.   ON x-1 GOSUB head.1,head.2,head.3,head.4
  724.   IF x<>5 THEN PUT (136,0),symbol(0,x):PUT (336,0),symbol(0,x)
  725.   FOR r=1 TO LOF(5)/58
  726.     GET 5,r
  727.     IF x=ASC(type$) THEN
  728.       flag=1
  729.       p=p+1:IF p=19 THEN wait.for.key:p=0:CLS
  730.       ON x-1 GOSUB print.1,print.2,print.3,print.4
  731.     END IF  
  732.   NEXT r
  733.   IF flag=0 THEN
  734.     PRINT"None Recorded"
  735.   ELSE
  736.     flag=0
  737.     IF x=2 THEN PRINT USING"Total Bills Due $$#######.##";total#
  738.   END IF
  739.   wait.for.key
  740. NEXT x  
  741. CLOSE 5:KILL"ram:temp"
  742. WINDOW CLOSE 3:RETURN main.menu
  743.  
  744. head.1: put.bold.char "BILLS",204,0
  745.  SAY TRANSLATE$("bills."),how
  746.  LOCATE 3,4:PRINT"Pay To";TAB(28);"Amount";TAB(47);"Due Date"
  747.  RETURN
  748. print.1: PRINT LEFT$(nam$,20)" ";
  749.   PRINT USING"$$#######.## ";VAL(RIGHT$(nam$,10));
  750.     PRINT dat$
  751.     total#=total#+VAL(RIGHT$(nam$,10))
  752.     RETURN
  753. head.2: put.bold.char "MEETINGS",188,0
  754.  SAY TRANSLATE$("meetings."),how
  755.  LOCATE 3,4:PRINT"What ?";TAB(16);"Where ?";TAB(37);"When ?"
  756.  RETURN
  757. print.2:  PRINT LEFT$(nam$,12)" ";
  758.   PRINT MID$(nam$,13,12)" ";:PRINT RIGHT$(nam$,6);
  759.     PRINT dat$
  760.     RETURN
  761. head.3: put.bold.char "NOTES",204,0
  762.  SAY TRANSLATE$("notes."),how
  763.  LOCATE 3,4:PRINT"Don't Forget to .......";;TAB(36);"Date"
  764.   RETURN
  765. print.3: PRINT nam$;dat$:RETURN
  766.  
  767. head.4: put.bold.char "HOLIDAYS",188,0
  768.  SAY TRANSLATE$("holidays"),how
  769.  LOCATE 3,19:PRINT"Permanent ?"
  770.   RETURN
  771. print.4: PRINT nam$;dat$:RETURN
  772.  
  773. diary:  SAY TRANSLATE$("dire e."),how
  774. WINDOW 3,"D I A R Y",(0,0)-(564,186),0,1
  775.   COLOR 1,6:CLS
  776. PATTERN &Hffff,cov.pat
  777.   COLOR 2,5:LINE (180,20)-(520,150),2,bf
  778. PATTERN &Hffff,r.edge.pat:COLOR 1,6
  779.   COLOR 1,7:AREA(522,25):AREA(540,41):AREA(540,165)
  780.   AREA(522,150):AREAFILL
  781. PATTERN &Hffff,b.edge.pat
  782.   AREA(522,151):AREA(537,163):AREA(198,163)
  783.   AREA(182,151):AREAFILL
  784.   LINE (536,38)-(539,38),2:LINE (180,20)-(520,150),2,b
  785.   LINE(540,38)-(541,164),2,b:LINE(200,164)-(541,164),2  
  786.   LINE(200,164)-(180,150),2:LINE(199,164)-(179,150),2
  787.   LINE(179,20)-(179,150),2:LINE(519,20)-(519,150),2
  788. put.bold.char "DIARY",274,50
  789. put.bold.num 370,50
  790. diary.date$="      "+day.name$(((month.marg+day-2) MOD 7)+1)+" "+month$(mo)+STR$(day)+","+year$+"          "
  791. t.code$=CHR$(mo)+CHR$(day)
  792. OPEN "diary.data"+year$ AS 5 LEN=520
  793.   FIELD 5,520 AS d.dat$
  794. OPEN "diary.index"+year$ AS 6 LEN=2
  795.  FIELD 6,2 AS f.code$
  796.   IF LOF(6)<2 THEN
  797.     i.rec=1
  798.     FOR x=1 TO 13:a$(x)=STRING$(40,32):NEXT x
  799.     GOTO open.book
  800.   END IF   
  801. FOR i.rec=1 TO LOF(6)/2:GET 6
  802.   IF f.code$=t.code$ THEN
  803.     GET 5,i.rec
  804.     FOR x=0 TO 12:a$(x+1)=MID$(d.dat$,x*40+1,40):NEXT x
  805.     GOTO open.book
  806.   END IF
  807. NEXT i.rec: FOR x=1 TO 13:a$(x)=STRING$(40,32):NEXT x  
  808. open.book: PATTERN &Hffff,cov.pat
  809.    y!=20:x2=0:c=0:y1=16:p=42
  810.   FOR x=508 TO 180 STEP-8
  811.    y!=y!-4:y2=y!+130
  812.    IF y!<1 THEN y1=0::x2=x-yb(c):c=c+1 :ELSE y1=CINT(y!):x2=x
  813.    IF y2<21 THEN y3=21 :ELSE y3=y2
  814.    IF y2<0 THEN y2=0
  815.     COLOR 2,5
  816.     AREA(x,y1):AREA(x,y2):AREA (180,150)
  817.     AREA(180,20):AREA(x2,y1):AREAFILL    
  818.    COLOR 1,1
  819.     AREA(x+1,y3):AREA(180,150):AREA(x+12,150)
  820.     AREA(x+12,24):AREA(x+1,24):AREAFILL
  821.    COLOR 6,6
  822.     AREA (x,y1):AREA(x,23):AREA(520,23):AREA(520,0)
  823.     AREAFILL 
  824.    IF p<41 AND p>0 THEN
  825.      COLOR 5,1
  826.      LOCATE 4,p+24:PRINT MID$(diary.date$,p,2);
  827.      COLOR 0,1:LOCATE 6,1
  828.      FOR dp=1 TO 13
  829.        PRINT TAB(p+23);MID$(a$(dp),p,1)
  830.      NEXT dp  
  831.    END IF
  832.    p=p-1
  833.   NEXT x  :c=36
  834.  FOR x=172 TO 8 STEP -8
  835.    y!=y!+4:y2=y!+130
  836.    IF y1<1 THEN y1=0::x2=x+yb(c)+10:c=c-1 :ELSE y1=CINT(y!):x2=x
  837.    IF y2<21 THEN y3=21 :ELSE y3=y2
  838.    IF y2<0 THEN y2=0
  839.     COLOR 2,4
  840.     AREA(x,y1):AREA(x,y2):AREA (180,152)
  841.     AREA(180,20):AREA(x2,y1):AREAFILL
  842.    COLOR 6,6
  843.     AREA (180,20):AREA(180,0):AREA(x2,0)
  844.     AREAFILL   
  845.    FOR pause=0 TO 200:NEXT pause
  846.  NEXT x
  847.  LINE(x+7,y1)-(x+7,y2),2:LINE-(180,152),2
  848.  LINE-(180,20),2:LINE-(x2,y1),2:LINE-(x+7,y1),2   
  849. put.bold.char "EXIT",232,170
  850. COLOR 0,1
  851. flag=0
  852. get.d.text 13,6,24,40,a$(),4,1
  853. IF flag=1 THEN
  854.  LSET f.code$=t.code$
  855.  PUT 6, i.rec
  856.   a$="":FOR x=1 TO 13:a$=a$+a$(x):NEXT x
  857.   LSET d.dat$=a$
  858.   PUT 5,i.rec
  859. END IF
  860. CLOSE 5:CLOSE 6:WINDOW CLOSE 3
  861. RETURN main.menu
  862. END
  863.  
  864. SUB put.bold.num (topx,topy) STATIC
  865.  SHARED num(),year$
  866.  FOR x=1 TO LEN(year$)
  867.   n=ASC(MID$(year$,x,1))-47
  868.   IF n<1 OR n>10 THEN skip8
  869.   PUT ((topx-16)+(x*16),topy),num(0,n)
  870.   skip8:
  871.  NEXT x
  872.   END SUB
  873.  
  874. SUB wait.for.key STATIC
  875.  SHARED how()
  876.  LOCATE 23,20:PRINT"PRESS ANY KEY OR MOUSE TO CONTINUE";
  877.  SAY TRANSLATE$("hit a key."),how
  878.  keep.waiting:
  879.   a$=INKEY$:IF a$="" AND MOUSE(0)>-1 THEN SLEEP:GOTO keep.waiting
  880.   LOCATE 23,20:PRINT SPACE$(25);
  881.   END SUB
  882. get.data:  GET 1,rec                          
  883.   FOR r=1 TO 10
  884.     f$(r)=MID$(c.dat$,r*30-29,30)
  885.     s(r)=ASC(MID$(s.nam$,r,1))
  886.   NEXT r
  887.   RETURN
  888. set.data: c$="":s$=""
  889.   FOR r=1 TO 10
  890.     c$=c$+f$(r):s$=s$+CHR$(s(r))
  891.   NEXT r  
  892.   LSET c.dat$=c$:LSET s.nam$=s$
  893.   PUT 1,rec
  894.   RETURN
  895.  
  896. SUB get.d.text(lines,topx,topy,wide,a$(),cur,bc) STATIC
  897. SHARED flag
  898. l=1:p=1:c=cur
  899. GOSUB putcur  
  900. getk:
  901.   IF MOUSE(0)<0 THEN
  902.     IF MOUSE(2)<(topx+lines-1)*8 AND MOUSE(2)>(topx-1)*8 AND MOUSE(1)>(topy-1)*8 AND MOUSE(1)<(topy+wide)*8 THEN
  903.       c=bc:GOSUB putcur:c=cur
  904.       p=INT(MOUSE(1)/8)-topy+2
  905.       l=INT(MOUSE(2)/8)-topx+2
  906.       GOSUB putcur
  907.     ELSEIF MOUSE(2)>170 AND MOUSE(2)<186 AND MOUSE(1)>232 AND MOUSE(1)<296 THEN
  908.       EXIT SUB
  909.     ELSE
  910.       BEEP
  911.     END IF
  912.   END IF         
  913.   a$=INKEY$
  914.   IF a$="" THEN SLEEP:GOTO getk
  915.   IF a$=CHR$(13) THEN 
  916.     IF l=lines THEN BEEP:GOTO getk
  917.     c=bc:GOSUB putcur:c=cur
  918.     p=1:l=l+1:GOTO 100
  919.   END IF   
  920.   IF a$=CHR$(8) THEN 
  921.     IF p>1 THEN 
  922.       c=bc:GOSUB putcur:c=cur 
  923.       p=p-1
  924.       a$(l)=LEFT$(a$(l),p-1)+MID$(a$(l),p+1)+" "
  925.       LOCATE topx+l-1,topy
  926.       PRINT a$(l)
  927.       GOTO 100
  928.     ELSEIF l<>1 THEN
  929.       c=bc:GOSUB putcur:c=cur:l=l-1:p=wide
  930.       a$(l)=LEFT$(a$(l),wide-1)+" "
  931.       LOCATE topx+l-1,topy
  932.       PRINT a$(l)
  933.       GOTO 100      
  934.     ELSE 
  935.       BEEP:GOTO getk
  936.     END IF
  937.   END IF   
  938.   ON INSTR(CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31),a$)GOTO up,down,right,left 
  939.   IF p>wide THEN
  940.     IF l=lines THEN BEEP:GOTO getk 
  941.       c=bc:GOSUB putcur:c=cur:GOSUB find.last.32
  942.     IF ls<40 AND a$<>CHR$(32) THEN
  943.       c=bc:GOSUB putcur:c=cur
  944.       chop$=RIGHT$(a$(l),wide-ls)
  945.       a$(l)=LEFT$(a$(l),ls)+SPACE$(wide-ls)
  946.       LOCATE topx+l-1,topy:PRINT a$(l)
  947.       l=l+1:p=LEN(chop$)+1
  948.       a$(l)=chop$+LEFT$(a$(l),wide-LEN(chop$))
  949.       LOCATE topx+l-1,topy:PRINT a$(l)
  950.     ELSE
  951.       l=l+1:p=1
  952.     END IF
  953.   END IF  
  954.     flag=1
  955.     MID$(a$(l),p,1)=a$
  956.     LOCATE topx+l-1,topy+p-1
  957.     PRINT a$;
  958.     p=p+1   
  959. 100 :
  960.   GOSUB putcur  
  961.   GOTO getk
  962. up:
  963.   IF l=1 THEN BEEP:GOTO getk
  964.   c=bc:GOSUB putcur:c=cur
  965.   l=l-1:GOTO 100
  966. down:
  967.   IF l=lines THEN BEEP:GOTO getk
  968.   c=bc:GOSUB putcur:c=cur
  969.   l=l+1:GOTO 100  
  970. right:
  971.   IF p>wide THEN
  972.     IF l=lines THEN BEEP:GOTO getk
  973.     c=bc:GOSUB putcur:c=cur:l=l+1:p=1:GOTO 100
  974.    END IF 
  975.   c=bc:GOSUB putcur:c=cur
  976.   p=p+1:GOTO 100
  977. left:
  978.   IF p=1 THEN 
  979.    IF l=1 THEN BEEP:GOTO getk
  980.    c=bc:GOSUB putcur:c=cur:l=l-1:p=wide:GOTO 100
  981.   END IF 
  982.   c=bc:GOSUB putcur:c=cur
  983.   p=p-1:GOTO 100
  984. putcur:
  985.   LINE((topy+p-2)*8,(topx+l-2)*8)-((topy+p-2)*8,(topx+l-2)*8+6),c
  986.   RETURN
  987. find.last.32: ps=0
  988.   find: ls=ps:ps=INSTR(ps+1,a$(l)," ")
  989.   IF ps=0 THEN RETURN
  990.   GOTO find    
  991. END SUB
  992.  
  993. payment.scedule: SAY TRANSLATE$("payment scedule."),how
  994.   GOSUB restore.
  995.   WINDOW 3,"Payment Scedules",(120,0)-(496,186),0,1
  996.   COLOR 1,7:CLS
  997.    LOCATE 1,34:PRINT"LAST PAYMENT"
  998.     LOCATE 2,1:PRINT"      PAY TO          AMOUNT   DAY (MO/YEAR)"
  999.     np$=STRING$(18,"0")
  1000.   OPEN "pay.scedule" AS 5 LEN=39
  1001.    FIELD 5, 20 AS pay.to$,10 AS amt$,2 AS day$,7 AS lp$
  1002.     IF LOF(5)=0 THEN
  1003.       LSET pay.to$=STRING$(20,32):LSET amt$=STRING$(10,32)
  1004.       LSET day$="  ":LSET lp$="       "
  1005.       FOR x=1 TO 18:PUT 5:NEXT x
  1006.       GOTO pay.menu
  1007.     END IF
  1008.   LOCATE 3,1:COLOR 2,7
  1009.   FOR x=1 TO 18:GET 5
  1010.     PRINT pay.to$" "amt$" "day$"  "lp$
  1011.     IF day$="  " THEN MID$(np$,x,1)="0" :ELSE MID$(np$,x,1)="1"
  1012.   NEXT x 
  1013.   put.bold.char "EXIT",168,170
  1014.  pay.menu:
  1015.    LOCATE 1,10:COLOR 0,5:PRINT"MAKE A SELECTION";
  1016.  repeat2:
  1017.    IF MOUSE(0)>-1 THEN repeat2
  1018.    LOCATE 1,10:COLOR 2,7:PRINT SPACE$(16);
  1019.    IF MOUSE(1)<352 AND MOUSE(1)>0 THEN
  1020.      IF MOUSE(2)>16 THEN IF MID$(np$,INT(MOUSE(2)/8)-1,1)="1" THEN GOSUB ps.edit
  1021.    END IF
  1022.    IF MOUSE(2)>170 AND MOUSE(1)>168 AND MOUSE(1)<232 THEN GOTO ps.exit
  1023.    GOSUB ps.input
  1024.  ps.input:  px=INSTR(np$,"0"):h=px+2
  1025.    IF px=0 THEN BEEP:RETURN pay.menu
  1026.    a$(1)=STRING$(20,32)
  1027.    input.ps h,1,20,a$(1)  'name
  1028.      IF flag=1 THEN MID$(np$,px,1)="0":RETURN pay.menu
  1029.    a$(2)=STRING$(10,32)
  1030.    input.ps h,22,10,a$(2) 'amount
  1031.      IF flag=1 THEN MID$(np$,px,1)="0":RETURN pay.menu
  1032.   day.again: 
  1033.    a$(3)=STRING$(2,32)
  1034.    input.ps h,33,2,a$(3)  'day
  1035.      IF flag=1 THEN MID$(np$,px,1)="0":RETURN pay.menu
  1036.      d=VAL(a$(3))
  1037.      IF d>28 OR d<1 THEN BEEP:GOTO day.again
  1038.   mo.year.again: 
  1039.    a$(4)=STRING$(7,32)
  1040.    input.ps h,37,7,a$(4)  'mo/year
  1041.      IF flag=1 THEN MID$(np$,px,1)="0":RETURN pay.menu
  1042.      m=VAL(LEFT$(a$(4),2))
  1043.      IF m>12 OR m<1 THEN BEEP:GOTO mo.year.again
  1044.    put.in.file:
  1045.     LSET pay.to$=a$(1):LSET amt$=a$(2)
  1046.     LSET day$=a$(3):LSET lp$=a$(4):PUT 5,px
  1047.     MID$(np$,px,1)="1"
  1048.     RETURN pay.menu
  1049.  ps.edit: px=INT(MOUSE(2)/8)+1:h=INT(MOUSE(1)/8)
  1050.      rec=px-2:GET 5,rec
  1051.      a$(1)=pay.to$:a$(2)=amt$:a$(3)=day$:a$(4)=lp$
  1052.    IF h<21 THEN
  1053.      py=1:x=1:l=20
  1054.    ELSEIF h<32 THEN
  1055.      py=22:x=2:l=10
  1056.    ELSEIF h<36 THEN
  1057.      py=33:x=3:l=2
  1058.    ELSE
  1059.      py=37:x=4:l=7
  1060.    END IF
  1061.    a$(x)=SPACE$(l)
  1062.   edit.again:
  1063.    input.ps px,py,l,a$(x)
  1064.      IF flag=1 THEN
  1065.        LSET pay.to$=" ":LSET amt$=" "
  1066.        LSET day$="  ":LSET lp$=" ":PUT 5,px
  1067.        MID$(np$,rec,1)="0"
  1068.        RETURN pay.menu
  1069.      END IF        
  1070.      IF x=3 THEN
  1071.        IF VAL(a$(3))>28 OR VAL(a$(3))<1 THEN edit.again
  1072.      END IF
  1073.      IF x=4 THEN
  1074.        IF VAL(LEFT$(a$(4),2))>12 OR VAL(LEFT$(a$(4),2))<1 THEN edit.again 
  1075.      END IF
  1076.      GOTO put.in.file
  1077.  ps.exit:
  1078.   LOCATE 22,1:PRINT SPACE$(40)
  1079.   PRINT"     Posting Payment Scedule on Calendar      "; 
  1080.   psexit:
  1081.   FOR ps=1 TO 18
  1082.     IF MID$(np$,ps,1)="1" THEN
  1083.      GET 5,ps
  1084.      FOR check.mo=9 TO 0 STEP -1 
  1085.       m=((mo+check.mo) MOD 12)+1:d=VAL(day$)
  1086.       IF d>day AND check.mo=0 THEN next.ps
  1087.       IF mo>m THEN y=year+1 :ELSE y=year
  1088.       find.rec m,d,y
  1089.       GOSUB get.data
  1090.       IF ASC(MID$(code$(m),d,1)) AND 2 THEN
  1091.         FOR x=1 TO 10
  1092.           IF s(x)=2 THEN
  1093.             IF LEFT$(f$(x),20)=pay.to$ THEN next.ps
  1094.           END IF
  1095.         NEXT x
  1096.       ELSE
  1097.         MID$(code$(m),d,1)=CHR$(ASC(MID$(code$(m),d,1))+2) 
  1098.         LSET cod$=code$(m):PUT 4,m
  1099.       END IF
  1100.       x=1
  1101.       WHILE s(x)<>0 AND x<11
  1102.         x=x+1
  1103.       WEND
  1104.        f$(x)=pay.to$+amt$:s(x)=2:GOSUB set.data              
  1105.      NEXT check.mo
  1106.     END IF
  1107.  next.ps: 
  1108.   NEXT ps    
  1109.   
  1110.   CLOSE 5:WINDOW CLOSE 3
  1111.   RETURN 
  1112. SUB find.rec (mo,day,year) STATIC
  1113. SHARED days.in.month(),rec
  1114.   rec=0
  1115.   IF year/4=INT(year/4) THEN leap.buf=0 :ELSE leap.buf=1
  1116.   IF mo>2 THEN rec=rec+leap.buf
  1117.   IF mo=1 THEN rec=day:EXIT SUB
  1118.   FOR x=1 TO mo-1:rec=rec+days.in.month(x):NEXT x
  1119.   rec=rec+day
  1120.   END SUB
  1121. SUB input.ps (px,py,length,word$) STATIC
  1122. SHARED flag
  1123.   flag=0:LOCATE px,py:PRINT SPACE$(length);
  1124.   no.input=0:c=5:p=1:GOSUB put.cursor
  1125.   getke: a$=INKEY$
  1126.    WHILE a$="":a$=INKEY$
  1127.    IF MOUSE(0)<0 THEN exitsub
  1128.    WEND
  1129.   IF a$<CHR$(127) AND a$>CHR$(31) THEN
  1130.    IF p>length THEN BEEP:GOTO getke
  1131.     MID$(word$,p,1)=a$:LOCATE px,py:PRINT word$
  1132.      p=p+1:c=5:GOSUB put.cursor
  1133.       GOTO getke
  1134.   END IF        
  1135.   IF a$=CHR$(127) THEN
  1136.     LOCATE px,1:PRINT SPACE$(45)
  1137.     flag=1
  1138.     EXIT SUB
  1139.   END IF 
  1140.    IF a$=CHR$(13) THEN 
  1141.    exitsub:
  1142.      c=7:GOSUB put.cursor
  1143.      EXIT SUB
  1144.    END IF          
  1145.   IF a$=CHR$(8) THEN
  1146.     IF p>1 THEN
  1147.       IF p=>length THEN c=7:GOSUB put.cursor
  1148.       p=p-1
  1149.       word$=LEFT$(word$,p-1)+MID$(word$,p+1)+" "
  1150.       LOCATE px,py:PRINT word$
  1151.       c=5:GOSUB put.cursor:GOTO getke
  1152.     ELSE
  1153.       BEEP:GOTO getke
  1154.     END IF
  1155.   END IF
  1156.    IF a$=CHR$(30) THEN
  1157.      IF p>length THEN BEEP:GOTO getke
  1158.      c=7:GOSUB put.cursor:p=p+1:c=5:GOSUB put.cursor
  1159.      GOTO getke
  1160.    END IF
  1161.   IF a$=CHR$(31) THEN
  1162.     IF p=1 THEN BEEP:GOTO getke
  1163.     c=7:GOSUB put.cursor:p=p-1:c=5:GOSUB put.cursor
  1164.     GOTO getke
  1165.   END IF
  1166.  BEEP:GOTO getke
  1167.   put.cursor:
  1168.     LINE((py+p-2)*8,(px-1)*8)-((py+p-2)*8,(px-1)*8+6),c
  1169.     RETURN
  1170.   END SUB
  1171. new.file: LSET c.dat$=SPACE$(300):LSET s.nam$=STRING$(10,0)
  1172.   FOR x=1 TO 366:PUT 1:NEXT x
  1173.   OPEN "cal.symbol.dat" AS 4 LEN=32
  1174.   FIELD 4,32 AS cod$:LSET cod$=STRING$(32,0)
  1175.   FOR x=1 TO 12:PUT 4:NEXT x
  1176.   CLOSE 4
  1177.   RETURN  
  1178.     
  1179.